home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 020 / modula.arc / EXEC.MOD < prev    next >
Encoding:
Modula Implementation  |  1986-08-20  |  4.6 KB  |  295 lines
  1.  
  2. IMPLEMENTATION MODULE Exec;
  3.  
  4.  
  5.  
  6. (**********************************************************)
  7.  
  8. (*   ROLLINS MEDICAL/DENTAL SYSTEMS                       *)
  9.  
  10. (*   360 CLAUSEN BUILDING                                 *)
  11.  
  12. (*   23100 PROVIDENCE DRIVE                               *)
  13.  
  14. (*   SOUTHFIELD, MI  48075-3677                           *)
  15.  
  16. (*                                                        *)
  17.  
  18. (*   Module: EXEC.MOD                                     *)
  19.  
  20. (*                                                        *)
  21.  
  22. (*   -------------------------------------------------    *)
  23.  
  24. (*  |                                                 |   *)
  25.  
  26. (*  | Call Dos Programs From Modula-2 Application.    |   *)
  27.  
  28. (*  | Logitech Implementation                         |   *)
  29.  
  30. (*   -------------------------------------------------    *)
  31.  
  32. (*                                                        *)
  33.  
  34. (*   Version: 01.00 a          Last Edit: 04/02/1986      *)
  35.  
  36. (*                                                        *)
  37.  
  38. (*   Programmer: J. Tal                                   *)
  39.  
  40. (*                                                        *)
  41.  
  42. (*   Public Domain Version                                *)
  43.  
  44. (**********************************************************)
  45.  
  46.  
  47.  
  48.  
  49.  
  50.  
  51.  
  52.  
  53.  
  54. FROM SYSTEM   IMPORT AX,BX,CX,DX,ES,SETREG,GETREG,CODE,SWI,WORD,BYTE,ADR,
  55.  
  56.                      ADDRESS,DOSCALL;
  57.  
  58. FROM DOS3     IMPORT GetProgramSegmentPrefix;
  59.  
  60. FROM Strings  IMPORT Concat,Copy,Length;
  61.  
  62.  
  63.  
  64.  
  65.  
  66. PROCEDURE Shell( COMMAND : ARRAY OF CHAR; VAR Error : CARDINAL);
  67.  
  68. VAR
  69.  
  70.   pspPTR,memTopPTR : POINTER TO CARDINAL;
  71.  
  72.   pspPTR2 : POINTER TO ARRAY[0..64] OF CHAR;
  73.  
  74.   Comaddr,pspadr,psp2adr,ComspecAdr,memTOPadr : ADDRESS;
  75.  
  76.   paramblock : ARRAY[0..6] OF WORD;
  77.  
  78.   Command : ARRAY[0..128] OF CHAR;
  79.  
  80.   Comspec : ARRAY[0..32] OF CHAR;
  81.  
  82.   PSPsegment,error,fctval,newBlockSize : WORD;
  83.  
  84.   psp,z,i,memTOP,memBOT,memAvail,newMemSize : CARDINAL;
  85.  
  86.   cr : CHAR;
  87.  
  88. BEGIN
  89.  
  90.   fctval := WORD(0);
  91.  
  92.   cr := CHR(13);
  93.  
  94.  
  95.  
  96.  
  97.  
  98.   (* --- prep Command Line for Param block --- *)
  99.  
  100.  
  101.  
  102.  
  103.  
  104.   Command := '/C ';
  105.  
  106.   Concat(Command,COMMAND,Command);
  107.  
  108.   z := Length(Command);
  109.  
  110.  
  111.  
  112.   Concat(Command,cr,Command);       (* append 0DH on end *)
  113.  
  114.  
  115.  
  116.   FOR i := (z+1) TO 1 BY -1 DO      (* shift string from end *)
  117.  
  118.     Command[i] := Command[i-1];
  119.  
  120.   END;
  121.  
  122.  
  123.  
  124.   Command[0] := CHR(z);             (* first byte must be length *)
  125.  
  126.   Command[z+2] := CHR(0);
  127.  
  128.  
  129.  
  130.   Comaddr := ADR(Command);
  131.  
  132.  
  133.  
  134.  
  135.  
  136.   (* ---------------- get PSP  --------------- *)
  137.  
  138.  
  139.  
  140.   GetProgramSegmentPrefix(PSPsegment);
  141.  
  142.   psp := CARDINAL(PSPsegment);
  143.  
  144.  
  145.  
  146.   pspadr.SEGMENT := psp;
  147.  
  148.   pspadr.OFFSET := 02CH;
  149.  
  150.  
  151.  
  152.  
  153.  
  154.   (* ---- calc total memory used right now by Modula-2 ------ *)
  155.  
  156.  
  157.  
  158.   memBOT := psp;
  159.  
  160.  
  161.  
  162.   memTOPadr.SEGMENT := psp;         (*  PSP:02H points to memtop  *)
  163.  
  164.   memTOPadr.OFFSET := 02H;
  165.  
  166.  
  167.  
  168.   memTopPTR := memTOPadr;
  169.  
  170.  
  171.  
  172.   memTOP := memTopPTR^;
  173.  
  174.  
  175.  
  176.   memAvail := memTOP - memBOT;
  177.  
  178.  
  179.  
  180.   newMemSize := memAvail - 1000H;   (*  snatch 64K away from application  *)
  181.  
  182.  
  183.  
  184.  
  185.  
  186.   (* ---------- Go get COMSPEC = ------------- *)
  187.  
  188.  
  189.  
  190.  
  191.  
  192.   pspPTR := pspadr;                 (* points to PSP + 2CH *)
  193.  
  194.  
  195.  
  196.   psp2adr.SEGMENT := pspPTR^;
  197.  
  198.   psp2adr.OFFSET := 0;
  199.  
  200.  
  201.  
  202.   pspPTR2 := psp2adr;               (* points to COMSPEC = *)
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.   (* ------- copy comspec to local area ------ *)
  211.  
  212.  
  213.  
  214.  
  215.  
  216.   Copy(pspPTR2^,8,24,Comspec);
  217.  
  218.   ComspecAdr := ADR(Comspec);
  219.  
  220.  
  221.  
  222.  
  223.  
  224.   (* ------- setup paramater block ----------- *)
  225.  
  226.  
  227.  
  228.  
  229.  
  230.   paramblock[0] := WORD(psp2adr.SEGMENT);     (*   environment string *)
  231.  
  232.   paramblock[1] := WORD(Comaddr.OFFSET);      (*  command line  *)
  233.  
  234.   paramblock[2] := WORD(Comaddr.SEGMENT);     (*  command line  *)
  235.  
  236.   paramblock[3] := WORD(05CH);                (*  PSP defaults  *)
  237.  
  238.   paramblock[4] := WORD(PSPsegment);              (*  "  *)
  239.  
  240.   paramblock[5] := WORD(06CH);                    (*  "  *)
  241.  
  242.   paramblock[6] := WORD(PSPsegment);              (*  "  *)
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.   (* --- Shrink memory by 64K to allow second Command.com --- *)
  251.  
  252.  
  253.  
  254.   newBlockSize := WORD(newMemSize);
  255.  
  256.   DOSCALL(4AH,pspadr,newBlockSize,error);
  257.  
  258.  
  259.  
  260.  
  261.  
  262.   (* ----------- if ok then EXEC ------------- *)
  263.  
  264.  
  265.  
  266.   Error := CARDINAL(error);
  267.  
  268.   IF Error = 0 THEN
  269.  
  270.     DOSCALL(4BH,ComspecAdr,ADR(paramblock),fctval,error);  (* EXEC - 4BH *)
  271.  
  272.     Error := CARDINAL(error);
  273.  
  274.  
  275.  
  276.    (* -- Restore memory (block) to original size -- *)
  277.  
  278.  
  279.  
  280.     newBlockSize := WORD(memAvail);
  281.  
  282.     DOSCALL(4AH,pspadr,newBlockSize,error);
  283.  
  284.   END;
  285.  
  286.  
  287.  
  288.  
  289.  
  290. END Shell;
  291.  
  292.  
  293.  
  294. END Exec.
  295.